home *** CD-ROM | disk | FTP | other *** search
/ L' Effet Pommier 3 / L'Effet Pommier - Volume 03.iso / Programmation / Alpha ƒ / Tcl / SystemCode / sql.tcl < prev    next >
Text File  |  1995-07-18  |  5KB  |  134 lines
  1.  
  2. #############################################################################
  3. #   FILE: sql.tcl
  4. #----------------------------------------------------------------------------
  5. # AUTHOR:     Joel D. Elkins
  6. #     of      New Media, Inc.
  7. #             200 South Meridian, Ste. 220
  8. #             Indianapolis, IN 46225
  9. #
  10. # internet:   jdelkins@iquest.net  (preferred)
  11. # compuserve: 72531,314
  12. # AOL:        jdelkins
  13. #
  14. #   Copyright ⌐ 1994-1995 by Joel D. Elkins
  15. #   All rights reserved.
  16. #############################################################################
  17. #
  18. #  Alpha mode for SQL and Oracle's PL/SQL programming language
  19. #  Converts SQL and PL/SQL keywords to uppercase on the fly and colorizes
  20. #
  21. #############################################################################
  22. # HISTORY
  23. #                  
  24. # modified who rev reason
  25. # -------- --- --- ------ 
  26. # 7/29/94  JDE 1.0 Original 
  27. # 2/8/95   JDE 1.1 Added electUpper for tab, cr, and ';'
  28. #############################################################################
  29.  
  30. proc dummySQL {} {}
  31.  
  32. #############################################################################
  33. # PL/SQL mode by Joel D. Elkins
  34. #############################################################################
  35. lappend modes SQL
  36. set modeMenus(SQL)                        { }
  37. set dummyProc(SQL)                        dummySQL
  38. lappend modeSuffixes                    {*.sql} { set winMode SQL }
  39. lappend modeSuffixes                    {*.SQL} { set winMode SQL }
  40. lappend modeSuffixes                    {*.pkg}    { set winMode SQL }
  41. newModeVar    SQL     elecRBrace            {0}    1
  42. newModeVar    SQL     electricSemi        {1}    1
  43. newModeVar    SQL        wordBreak            {(\$)?[a-zA-Z0-9_]+} 0
  44. newModeVar    SQL        prefixString        {--} 0
  45. newModeVar    SQL        elecLBrace            {0} 1
  46. newModeVar    SQL        wordWrap            {0} 1
  47. newModeVar    SQL        funcExpr            {(PROCEDURE|FUNCTION)[ \t]+([a-zA-Z0-9_]+)} 0
  48. newModeVar    SQL        wordBreakPreface    {[^a-zA-Z0-9_\$]} 0
  49.  
  50. set sqlKeywords {
  51.     ABORT ACCEPT ACCESS ALTER AND ARRAY ARRAYLEN AS ASSERT AT AVG BEGIN BETWEEN BODY
  52.     CASE COLUMNS COMMIT CONSTANT COUNT CREATE CURSOR DECLARE DEFAULT DEFINITION
  53.     DELETE DESC DISPOSE DISTINCT DO DROP ELSE ELSIF END ENTRY EXCEPTION EXISTS EXIT
  54.     FALSE FETCH FOR FROM FUNCTION GOTO IF IN INSERT INTERSECT INTO IS LIKE LOOP MAX MIN
  55.     MINUS MOD NEW OF ON OPEN OR OUT PACKAGE PARTITION POSITIVE PRAGMA PRIVATE
  56.     PROCEDURE PUBLIC RANGE RECORD REM REPLACE RETURN ROLLBACK ROWTYPE RUN SAVEPOINT
  57.     SELECT SET SIZE START STDDEV SUM THEN TO TYPE UNION UNIQUE UPDATE USE VALUES
  58.     VARIANCE WHEN WHERE WHILE WITH XOR
  59. }
  60. ###    Just colorize uppercase keywords
  61. #    abort accept access alter and array arraylen as assert at avg begin between body
  62. #    case columns commit constant count create cursor declare default definition
  63. #    delete desc dispose distinct do drop else elsif end entry exception exists exit
  64. #    false fetch for from function goto if in insert intersect into is like loop max min
  65. #    minus mod new of on open or out package partition positive pragma private
  66. #    procedure public range record rem replace return rollback rowtype run savepoint
  67. #    select set size start stddev sum then to type union unique update use values
  68. #    variance when where while with xor
  69. ###
  70. regModeKeywords -e {--} -b {/*} {*/} -c red -k blue SQL $sqlKeywords
  71. unset sqlKeywords
  72. #================================================================================
  73.  
  74. catch {unset plSqlKeywords}
  75.  
  76. lappend plSqlKeywords \
  77.     abort accept access alter and array arraylen as assert at avg begin between body \
  78.     case columns commit constant count create cursor declare default definition \
  79.     delete desc dispose distinct do drop else elsif end entry exception exists exit \
  80.     false fetch for from function goto if in insert intersect into is like loop max min \
  81.     minus mod new of on open or out package partition positive pragma private \
  82.     procedure public range record rem replace return rollback rowtype run savepoint \
  83.     select set size start stddev sum then to type union unique update use values \
  84.     variance when where while with xor
  85.  
  86.  
  87. proc electUpper {char} {
  88.     global plSqlKeywords
  89.     
  90.     set a [getPos]
  91.     backwardWord
  92.     set b [getPos]
  93.     
  94.     #make sure we're not in a comment
  95.     beginningOfLine
  96.     set commentSearch {(^[ \t]*rem[ \t]+)|(^[ \t]*REM[ \t]+)|--}
  97.     if {[catch {search -r 1 -f 1 -l $b -- $commentSearch [getPos]}] != 0} {
  98.         #if not, make the word uppercase if it's a keyword
  99.         set cmd [getText $b $a]
  100.         goto $b
  101.         if {[lsearch -exact $plSqlKeywords $cmd] >= 0} {
  102.             upcaseWord
  103.         }
  104.     }
  105.     goto $a
  106.     if { 0 == [string compare $char "\r"] } {
  107.         carriageReturn
  108.     } else {
  109.         insertText $char
  110.     }
  111. }
  112.  
  113. bind '\ ' {electUpper "\ "} "SQL"
  114. bind '\t' {electUpper "\t"} "SQL"
  115. bind '\r' {electUpper "\r"} "SQL"
  116. bind '\;' {electUpper "\;"} "SQL"
  117.  
  118. proc SQLMarkFile {} {
  119.     global SQLmodeVars
  120.     set pos 0
  121.     while {![catch {search -f 1 -r 1 -m 0 -i 0 $SQLmodeVars(funcExpr) $pos} res]} {
  122.         set start [lindex $res 0]
  123.         set end [lindex $res 1]
  124.         set text [lindex [getText $start $end] 1]
  125.         set pos $end
  126.         set inds($text) "$start $end"
  127.     }
  128.     
  129.     if {[info exists inds]} {
  130.         foreach f [lsort [array names inds]] {
  131.             setNamedMark $f [lineStart [lineStart [lindex $inds($f) 0]] - 1] [lindex $inds($f) 0] [lindex $inds($f) 1]
  132.         }
  133.     }
  134. }